home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 042a / swagdef.zip / DOS.SWG < prev    next >
Text File  |  1993-05-28  |  22KB  |  1 lines

  1. SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00005         DOS & ENVIRONMENT ROUTINES                                        1      05-28-9313:38ALL                      SWAG SUPPORT TEAM        EXPFHT.PAS               IMPORT              18          Unit expfht;ππ  { Author: Trevor J Carlsen  Released into the public domain }π  {         PO Box 568                                        }π  {         Port Hedland                                      }π  {         Western Australia 6721                            }π  {         Voice +61 91 732 026                              }ππ  { EXPFHT: This Unit allows an application to expand the number of File }π  { handles in use. It is limited to the number permitted by Dos and     }π  { initialised in the FileS= of the config.sys File.                    }ππInterfaceππConstπ  NumbFiles= 105;π  { Set to the number of File handles needed. 99 will be the max With }π  { Dos 2.x and 254 With Dos 3.x. (I don't know why not 255!)         }πTypeπ  fht      = Array[1..NumbFiles] of Byte;πVarπ  NewFHT   : fht;π  OldFHT   : LongInt;π  OldSize  : Word;π                    πFunction MakeNewFHT: Boolean;πProcedure RestoreOldFHT;πππImplementationππConstπ  Successful : Boolean = False;ππVarπ  OldExitProc  : Pointer;ππ{$R-}πFunction MakeNewFHT : Boolean;π  { create a new expanded File handle table - True if successful }π  Constπ    AlreadyUsed : Boolean = False;π  beginπ    if not AlreadyUsed then beginπ      AlreadyUsed := True;π      MakeNewFHT := True;π      Successful := True;π      OldFHT  := MemL[PrefixSeg:$34];            { Store the old FHT address }π      FillChar(NewFHT,NumbFiles,$ff);              { Fill new table With 255 }π      Oldsize := MemW[PrefixSeg:$32];               { Store the old FHT size }π      MemW[PrefixSeg:$32] := NumbFiles;            { Put new size in the psp }π      MemL[PrefixSeg:$34] := LongInt(@NewFHT);      { new FHT address in psp }π      move(Mem[PrefixSeg:$19],NewFHT,$15);      { put contents of old to new }π    end { if not AllreadyUsed }π    else MakeNewFHT := False;π  end; { MakeNewFHT }π{$R+}ππ{$F+}πProcedure RestoreOldFHT;π  beginπ    ExitProc := OldExitProc;π    if Successful then beginπ      MemW[PrefixSeg:$32] := OldSize;π      MemL[PrefixSeg:$34] := OldFHT;π    end;  π  end;π{$F-}ππbeginπ  OldExitProc := ExitProc;π  ExitProc    := @RestoreOldFHT;πend.ππ                                                            2      05-28-9313:38ALL                      SWAG SUPPORT TEAM        NEWENV.PAS               IMPORT              29          {π The following TP code assigns a new Environment to the COMMand.COMπ which is invoked by TP's EXEC Function.  In this Case, it is usedπ to produce a Dos PROMPT which is different from the one in the Masterπ Environment.  Control is returned when the user Types Exit ...π}ππ{ Reduce Retained Memory }ππ{$M 2048,0,0}ππProgram NewEnv;πUsesπ  Dos;πTypeπ  String128   = String[128];πConstπ  NewPrompt   =π    'PROMPT=$e[32mType Exit to Return to The Fitness Profiler$e[0m$_$_$p$g' + #0;πVarπ  EnvironNew,π  EnvironOld,π  offsetN,π  offsetO,π  SegBytes    : Word;π  TextBuff    : String128;π  Found,π  Okay        : Boolean;π  Reg         : Registers;ππFunction AllocateSeg( BytesNeeded : Word ) : Word;πbeginπ  Reg.AH := $48;π  Reg.BX := BytesNeeded div 16;π  MsDos( Reg );π  if Reg.Flags and FCarry <> 0 thenπ    AllocateSeg := 0π  elseπ    AllocateSeg := Reg.AX;πend {AllocateSeg};ππProcedure DeAllocateSeg( AllocSeg : Word; Var okay : Boolean );πbeginπ  Reg.ES := AllocSeg;π  Reg.AH := $49;π  MsDos( Reg );π  if Reg.Flags and FCarry <> 0 thenπ    okay := Falseπ  elseπ    okay := True;πend {DeAllocateSeg};ππFunction EnvReadLn( EnvSeg : Word; Var Envoffset : Word ) : String128;πVarπ  tempstr : String128;π  loopc   : Byte;πbeginπ  loopc := 0;π  Repeatπ    inC( loopc );π    tempstr[loopc] := CHR(Mem[EnvSeg:Envoffset]);π    inC( Envoffset );π  Until tempstr[loopc] = #0;π  tempstr[0] := CHR(loopc);       {set str length}π  EnvReadLn := tempstrπend {ReadEnvLn};ππProcedure EnvWriteLn( EnvSeg : Word; Var Envoffset : Word;π                      AsciizStr : String );πVarπ  loopc   : Byte;πbeginπ  For loopc := 1 to Length( AsciizStr ) doπ  beginπ    Mem[EnvSeg:Envoffset] := orD(AsciizStr[loopc]);π    inC( Envoffset )π  endπend {EnvWriteLn};ππbegin   {main}π  WriteLn(#10,'NewEnv v0.0 Dec.25.91 Greg Vigneault');π  SegBytes := 1024;    { size of new environment (up to 32k)}π  EnvironNew := AllocateSeg( SegBytes );π  if EnvironNew = 0 thenπ  begin    { asked For too much memory? }π    WriteLn('Can''t allocate memory segment Bytes.',#7);π    Halt(1)π  end;π  EnvironOld := MemW[ PrefixSeg:$002c ];   { current environ }π  { copy orig env, but change the PROMPT command }π  Found := False;π  offsetO := 0;π  offsetN := 0;π  Repeat  { copy one env Var at a time, old env to new env}π    TextBuff := EnvReadLn( EnvironOld, offsetO );π    if offsetO >= SegBytes thenπ    begin { not enough space? }π      WriteLn('not enough new Environment space',#7);π      DeAllocateSeg( EnvironNew, okay );π      Halt(2)     { abort to Dos }π    end;π    { check For the PROMPT command String }π    if Pos('PROMPT=',TextBuff) = 1 thenπ    begin { prompt command? }π      TextBuff := NewPrompt;          { set new prompt }π      Found := True;π    end;π    { now Write the Variable to new environ }π    EnvWriteLn( EnvironNew, offsetN, TextBuff );π    { loop Until all Variables checked/copied }π  Until Mem[EnvironOld:offsetO] = 0;π  { if no prompt command found, create one }π  if not Found thenπ    EnvWriteLn( EnvironNew, offsetN, NewPrompt );π  Mem[EnvironNew:offsetN] := 0;           { delimit new environ}π  MemW[ PrefixSeg:$2c ] := EnvironNew;    { activate new env }π  WriteLn( #10, '....Type Exit to return to normal prompt...' );π  SwapVectors;π  Exec( GetEnv('COMSPEC'),'/S');  {shell to Dos w/ new prompt}π  SwapVectors;π  MemW[ PrefixSeg:$2c ] := EnvironOld;   { restore original env}π  DeAllocateSeg( EnvironNew, okay );π  if not okay thenπ    WriteLn( 'Could not release memory!',#7 );πend {NewEnv}.π(*******************************************************************)π             3      05-28-9313:38ALL                      SWAG SUPPORT TEAM        REBOOT.PAS               IMPORT              6           Procedure Warm_Boot;π Beginπ  Inline($BB/$00/$01/$B8/$40/$00/$8E/$D8/π         $89/$1E/$72/$00/$EA/$00/$00/$FF/$FF);π End;ππProcedure Cold_Boot;π Beginπ  Inline($BB/$38/$12/$B8/$40/$00/$8E/$D8/π         $89/$1E/$72/$00/$EA/$00/$00/$FF/$FF);π End;ππI saw that you were posting reboot procedures...I didn't catch what it was forπthough, but maybe these will help.πππ--- XANADU (1:124/7007)π * Origin: * XANADU * Grand Prairie, TX * (1:124/7007)π                                                                                                                                                                                                     4      05-28-9313:38ALL                      SWAG SUPPORT TEAM        REBOOT2.PAS              IMPORT              8           # Der User Chris Obee@1:234/26 musste am Donnerstag, dem 22.04.93 um 12:09 Uhrπ# in der Area PASCAL folgendes seiner Tastatur antun................ππ>     I would like to write a program in pascal that will accomplish anπ> complete system reboot.  The moral equivilent of pressing the big redπ> button.  A program that simulates the Cntr-Alt-Del sequence is notπ> sufficient.  Anyone who can advise me on if this is possible of not, willπ> receive many thanks.π>π> TTFN:  chrisππThat's not as hard as it might seem to be at first glance:ππprogram coldboot;πbeginπ memw[0:$0472] := 0;π asmπ  mov ax,$FFFFπ  mov ds,axπ  jmp far ptr ds:0π end;πend.ππHope you understand the assembler code... :-)πππMichael : [NICO] : [Whoo haz broquen mei brain-waschaer?]π~~~~~~~~~~~~~~~~ππ--- CrossPoint v2.1π * Origin: Send me ALL your money - IMMEDIATELY!! (2:2401/411.2)π                                        5      05-28-9313:38ALL                      SWAG SUPPORT TEAM        TPENV.PAS                IMPORT              107         {$R-,S-,V-,I-,B-,F-}ππ{Disable the following define if you don't have Turbo Professional}π{$DEFINE UseTpro}ππ{*********************************************************}π{*                    TPENV.PAS 1.02                     *}π{*                by TurboPower Software                 *}π{*********************************************************}ππ{π  Version 1.01 11/7/88π    Find master environment in Dos 3.3 and 4.0π  Version 1.02 11/14/88π    Correctly find master environment when runπ      Within AUTOEXEC.BATπ}ππUnit TpEnv;π  {-Manipulate the environment}ππInterfaceππUses Opus;ππTypeπ  EnvArray = Array[0..32767] of Char;π  EnvArrayPtr = ^EnvArray;π  EnvRec =π    Recordπ      EnvSeg : Word;              {Segment of the environment}π      EnvLen : Word;              {Usable length of the environment}π      EnvPtr : Pointer;           {Nil except when allocated on heap}π    end;ππConstπ  ShellUserProc : Pointer = nil;  {Put address of ExecDos user proc here if desiππProcedure MasterEnv(Var Env : EnvRec);π  {-Return master environment Record}ππProcedure CurrentEnv(Var Env : EnvRec);π  {-Return current environment Record}ππProcedure NewEnv(Var Env : EnvRec; Size : Word);π  {-Allocate a new environment on the heap}ππProcedure DisposeEnv(Var Env : EnvRec);π  {-Deallocate an environment previously allocated on heap}ππProcedure SetCurrentEnv(Env : EnvRec);π  {-Specify a different environment For the current Program}ππProcedure CopyEnv(Src, Dest : EnvRec);π  {-Copy contents of Src environment to Dest environment}ππFunction EnvFree(Env : EnvRec) : Word;π  {-Return Bytes free in environment}ππFunction GetEnvStr(Env : EnvRec; Search : String) : String;π  {-Return a String from the environment}ππFunction SetEnvStr(Env : EnvRec; Search, Value : String) : Boolean;π  {-Set environment String, returning True if successful}ππProcedure DumpEnv(Env : EnvRec);π  {-Dump the environment to StdOut}ππFunction ProgramStr : String;π  {-Return the complete path to the current Program, '' if Dos < 3.0}ππFunction SetProgramStr(Env : EnvRec; Path : String) : Boolean;π  {-Add a Program name to the end of an environment if sufficient space}ππ  {$IFDEF UseTpro}πFunction ShellWithPrompt(Prompt : String) : Integer;π  {-Shell to Dos With a new prompt}π  {$endIF}ππProcedure DisposeEnv(Var Env : EnvRec);π  {-Deallocate an environment previously allocated on heap}πbeginπ  With Env doπ    if EnvPtr <> nil then beginπ      FreeMem(EnvPtr, EnvLen+31);π      ClearEnvRec(Env);π    end;πend;ππProcedure SetCurrentEnv(Env : EnvRec);π  {-Specify a different environment For the current Program}πbeginπ  With Env doπ    if EnvSeg <> 0 thenπ      MemW[PrefixSeg:$2C] := EnvSeg;πend;ππProcedure CopyEnv(Src, Dest : EnvRec);π  {-Copy contents of Src environment to Dest environment}πVarπ  Size : Word;π  SPtr : EnvArrayPtr;π  DPtr : EnvArrayPtr;πbeginπ  if (Src.EnvSeg = 0) or (Dest.EnvSeg = 0) thenπ    Exit;ππ  if Src.EnvLen <= Dest.EnvLen thenπ    {Space For the whole thing}π    Size := Src.EnvLenπ  elseπ    {Take what fits}π    Size := Dest.EnvLen-1;ππ  SPtr := Ptr(Src.EnvSeg, 0);π  DPtr := Ptr(Dest.EnvSeg, 0);π  Move(SPtr^, DPtr^, Size);π  FillChar(DPtr^[Size], Dest.EnvLen-Size, 0);πend;ππProcedure SkipAsciiZ(EPtr : EnvArrayPtr; Var EOfs : Word);π  {-Skip to end of current AsciiZ String}πbeginπ  While EPtr^[EOfs] <> #0 doπ    Inc(EOfs);πend;ππFunction EnvNext(EPtr : EnvArrayPtr) : Word;π  {-Return the next available location in environment at EPtr^}πVarπ  EOfs : Word;πbeginπ  EOfs := 0;π  if EPtr <> nil then beginπ    While EPtr^[EOfs] <> #0 do beginπ      SkipAsciiZ(EPtr, EOfs);π      Inc(EOfs);π    end;π  end;π  EnvNext := EOfs;πend;ππFunction EnvFree(Env : EnvRec) : Word;π  {-Return Bytes free in environment}πbeginπ  With Env doπ    if EnvSeg <> 0 thenπ      EnvFree := EnvLen-EnvNext(Ptr(EnvSeg, 0))-1π    elseπ      EnvFree := 0;πend;ππ{$IFNDEF UseTpro}πFunction StUpcase(S : String) : String;π  {-Uppercase a String}πVarπ  SLen : Byte Absolute S;π  I : Integer;πbeginπ  For I := 1 to SLen doπ    S[I] := UpCase(S[I]);π  StUpcase := S;πend;πFunction SearchEnv(EPtr : EnvArrayPtr;π                   Var Search : String) : Word;π  {-Return the position of Search in environment, or $FFFF if not found.π    Prior to calling SearchEnv, assure thatπ      EPtr is not nil,π      Search is not emptyπ  }πVarπ  SLen : Byte Absolute Search;π  EOfs : Word;π  MOfs : Word;π  SOfs : Word;π  Match : Boolean;πbeginπ  {Force upper Case search}π  Search := Upper(Search);ππ  {Assure search String ends in =}π  if Search[SLen] <> '=' then beginπ    Inc(SLen);π    Search[SLen] := '=';π  end;ππ  EOfs := 0;π  While EPtr^[EOfs] <> #0 do beginπ    {At the start of a new environment element}π    SOfs := 1;π    MOfs := EOfs;π    Repeatπ      Match := (EPtr^[EOfs] = Search[SOfs]);π      if Match then beginπ        Inc(EOfs);π        Inc(SOfs);π      end;π    Until not Match or (SOfs > SLen);ππ    if Match then beginπ      {Found a match, return index of start of match}π      SearchEnv := MOfs;π      Exit;π    end;ππ    {Skip to end of this environment String}π    SkipAsciiZ(EPtr, EOfs);ππ    {Skip to start of next environment String}π    Inc(EOfs);π  end;ππ  {No match}π  SearchEnv := $FFFF;πend;ππProcedure GetAsciiZ(EPtr : EnvArrayPtr; Var EOfs : Word; Var EStr : String);π  {-Collect AsciiZ String starting at EPtr^[EOfs]}πVarπ  ELen : Byte Absolute EStr;πbeginπ  ELen := 0;π  While (EPtr^[EOfs] <> #0) and (ELen < 255) do beginπ    Inc(ELen);π    EStr[ELen] := EPtr^[EOfs];π    Inc(EOfs);π  end;πend;ππFunction GetEnvStr(Env : EnvRec; Search : String) : String;π  {-Return a String from the environment}πVarπ  SLen : Byte Absolute Search;π  EPtr : EnvArrayPtr;π  EOfs : Word;π  EStr : String;π  ELen : Byte Absolute EStr;πbeginπ  With Env do beginπ    ELen := 0;π    if (EnvSeg <> 0) and (SLen <> 0) then beginπ      {Find the search String}π      EPtr := Ptr(EnvSeg, 0);π      EOfs := SearchEnv(EPtr, Search);π      if EOfs <> $FFFF then beginπ        {Skip over the search String}π        Inc(EOfs, SLen);π        {Build the result String}π        GetAsciiZ(EPtr, EOfs, EStr);π      end;π    end;π    GetEnvStr := EStr;π  end;πend;ππImplementationππTypeπSO =π  Recordπ    O : Word;π    S : Word;π  end;ππProcedure ClearEnvRec(Var Env : EnvRec);π  {-Initialize an environment Record}πbeginπ  FillChar(Env, SizeOf(Env), 0);πend;ππProcedure MasterEnv(Var Env : EnvRec);π  {-Return master environment Record}πVarπ  Owner : Word;π  Mcb : Word;π  Eseg : Word;π  Done : Boolean;πbeginπ  With Env do beginπ    ClearEnvRec(Env);ππ    {Interrupt $2E points into COMMAND.COM}π    Owner := MemW[0:(2+4*$2E)];ππ    {Mcb points to memory control block For COMMAND}π    Mcb := Owner-1;π    if (Mem[Mcb:0] <> Byte('M')) or (MemW[Mcb:1] <> Owner) thenπ      Exit;ππ    {Read segment of environment from PSP of COMMAND}π    Eseg := MemW[Owner:$2C];ππ    {Earlier versions of Dos don't store environment segment there}π    if Eseg = 0 then beginπ      {Master environment is next block past COMMAND}π      Mcb := Owner+MemW[Mcb:3];π      if (Mem[Mcb:0] <> Byte('M')) or (MemW[Mcb:1] <> Owner) thenπ        {Not the right memory control block}π        Exit;π      Eseg := Mcb+1;π    end elseπ      Mcb := Eseg-1;ππ    {Return segment and length of environment}π    EnvSeg := Eseg;π    EnvLen := MemW[Mcb:3] shl 4;π  end;πend;ππProcedure CurrentEnv(Var Env : EnvRec);π  {-Return current environment Record}πVarπ  ESeg : Word;π  Mcb : Word;πbeginπ  With Env do beginπ    ClearEnvRec(Env);π    ESeg := MemW[PrefixSeg:$2C];π    Mcb := ESeg-1;π    if (Mem[Mcb:0] <> Byte('M')) or (MemW[Mcb:1] <> PrefixSeg) thenπ      Exit;π    EnvSeg := ESeg;π    EnvLen := MemW[Mcb:3] shl 4;π  end;πend;ππProcedure NewEnv(Var Env : EnvRec; Size : Word);π  {-Allocate a new environment (on the heap)}πVarπ  Mcb : Word;πbeginπ  With Env doπ    if MaxAvail < Size+31 thenπ      {Insufficient space}π      ClearEnvRec(Env)π    else beginπ      {31 extra Bytes For paraGraph alignment, fake MCB}π      GetMem(EnvPtr, Size+31);π      EnvSeg := SO(EnvPtr).S+1;π      if SO(EnvPtr).O <> 0 thenπ        Inc(EnvSeg);π      EnvLen := Size;π      {Fill it With nulls}π      FillChar(EnvPtr^, Size+31, 0);π      {Make a fake MCB below it}π      Mcb := EnvSeg-1;π      Mem[Mcb:0] := Byte('M');π      MemW[Mcb:1] := PrefixSeg;π      MemW[Mcb:3] := (Size+15) shr 4;π    end;πend;ππFunction SetEnvStr(Env : EnvRec; Search, Value : String) : Boolean;π  {-Set environment String, returning True if successful}πVarπ  SLen : Byte Absolute Search;π  VLen : Byte Absolute Value;π  EPtr : EnvArrayPtr;π  ENext : Word;π  EOfs : Word;π  MOfs : Word;π  OldLen : Word;π  NewLen : Word;π  NulLen : Word;πbeginπ  With Env do beginπ    SetEnvStr := False;π    if (EnvSeg = 0) or (SLen = 0) thenπ      Exit;π    EPtr := Ptr(EnvSeg, 0);ππ    {Find the search String}π    EOfs := SearchEnv(EPtr, Search);ππ    {Get the index of the next available environment location}π    ENext := EnvNext(EPtr);ππ    {Get total length of new environment String}π    NewLen := SLen+VLen;ππ    if EOfs <> $FFFF then beginπ      {Search String exists}π      MOfs := EOfs+SLen;π      {Scan to end of String}π      SkipAsciiZ(EPtr, MOfs);π      OldLen := MOfs-EOfs;π      {No extra nulls to add}π      NulLen := 0;π    end else beginπ      OldLen := 0;π      {One extra null to add}π      NulLen := 1;π    end;ππ    if VLen <> 0 thenπ      {Not a pure deletion}π      if ENext+NewLen+NulLen >= EnvLen+OldLen thenπ        {New String won't fit}π        Exit;ππ    if OldLen <> 0 then beginπ      {OverWrite previous environment String}π      Move(EPtr^[MOfs+1], EPtr^[EOfs], ENext-MOfs-1);π      {More space free now}π      Dec(ENext, OldLen+1);π    end;ππ    {Append new String}π    if VLen <> 0 then beginπ      Move(Search[1], EPtr^[ENext], SLen);π      Inc(ENext, SLen);π      Move(Value[1], EPtr^[ENext], VLen);π      Inc(ENext, VLen);π    end;ππ    {Clear out the rest of the environment}π    FillChar(EPtr^[ENext], EnvLen-ENext, 0);ππ    SetEnvStr := True;π  end;πend;ππProcedure DumpEnv(Env : EnvRec);π  {-Dump the environment to StdOut}πVarπ  EOfs : Word;π  EPtr : EnvArrayPtr;πbeginπ  With Env do beginπ    if EnvSeg = 0 thenπ      Exit;π    EPtr := Ptr(EnvSeg, 0);π    EOfs := 0;π    WriteLn;π    While EPtr^[EOfs] <> #0 do beginπ      While EPtr^[EOfs] <> #0 do beginπ        Write(EPtr^[EOfs]);π        Inc(EOfs);π      end;π      WriteLn;π      Inc(EOfs);π    end;π    WriteLn('Bytes free: ', EnvFree(Env));π  end;πend;π{$IFDEF UseTpro}πFunction ShellWithPrompt(Prompt : String) : Integer;π  {-Shell to Dos With a new prompt}πConstπ  PromptStr : String[7] = 'PROMPT=';πVarπ  PLen : Byte Absolute Prompt;π  NSize : Word;π  Status : Integer;π  CE : EnvRec;π  NE : EnvRec;π  OldP : String;π  OldPLen : Byte Absolute OldP;πbeginπ  {Point to current environment}π  CurrentEnv(CE);π  if CE.EnvSeg = 0 then beginπ    {Error getting environment}π    ShellWithPrompt := -5;π    Exit;π  end;ππ  {Compute size of new environment}π  OldP := GetEnvStr(CE, PromptStr);π  NSize := CE.EnvLen;π  if OldPLen < PLen thenπ    Inc(NSize, PLen-OldPLen);ππ  {Allocate and initialize a new environment}π  NewEnv(NE, NSize);π  if NE.EnvSeg = 0 then beginπ    {Insufficient memory For new environment}π    ShellWithPrompt := -6;π    Exit;π  end;π  CopyEnv(CE, NE);ππ  {Get the Program name from the current environment}π  OldP := ProgramStr;ππ  {Set the new prompt String}π  if not SetEnvStr(NE, PromptStr, Prompt) then beginπ    {Program error, should have enough space}π    ShellWithPrompt := -7;π    Exit;π  end;ππ  {Transfer Program name to new environment if possible}π  if not SetProgramStr(NE, OldP) thenπ    ;ππ  {Point to new environment}π  SetCurrentEnv(NE);ππ  {Shell to Dos With new prompt in place}π  {Status := Exec('', True, ShellUserProc);}ππ  {Restore previous environment}π  SetCurrentEnv(CE);ππ  {Release the heap space}π  if Status >= 0 thenπ    DisposeEnv(NE);ππ  {Return exec status}π  ShellWithPrompt := Status;πend;π{$endIF}ππend.ππ{ EXAMPLE PROGRAM }ππFunction DosVersion : Word;π  {-Return the Dos version, major part in AX}πInline(π  $B4/$30/                 {mov ah,$30}π  $CD/$21/                 {int $21}π  $86/$C4);                {xchg ah,al}ππFunction ProgramStr : String;π  {-Return the name of the current Program, '' if Dos < 3.0}πVarπ  EOfs : Word;π  Env : EnvRec;π  EPtr : EnvArrayPtr;π  PStr : String;πbeginπ  ProgramStr := '';π  if DosVersion < $0300 thenπ    Exit;π  CurrentEnv(Env);π  if Env.EnvSeg = 0 thenπ    Exit;π  {Find the end of the current environment}π  EPtr := Ptr(Env.EnvSeg, 0);π  EOfs := EnvNext(EPtr);π  {Skip to start of path name}π  Inc(EOfs, 3);π  {Collect the path name}π  GetAsciiZ(EPtr, EOfs, PStr);π  ProgramStr := PStr;πend;ππFunction SetProgramStr(Env : EnvRec; Path : String) : Boolean;π  {-Add a Program name to the end of an environment if sufficient space}πVarπ  PLen : Byte Absolute Path;π  EOfs : Word;π  Numb : Word;π  EPtr : EnvArrayPtr;πbeginπ  SetProgramStr := False;π  With Env do beginπ    if EnvSeg = 0 thenπ      Exit;π    {Find the end of the current environment}π    EPtr := Ptr(EnvSeg, 0);π    EOfs := EnvNext(EPtr);π    {Assure space For path}π    if EnvLen < PLen+EOfs+4 thenπ      Exit;π    {Put in the count field}π    Inc(EOfs);π    Numb := 1;π    Move(Numb, EPtr^[EOfs], 2);π    {Skip to start of path name}π    Inc(EOfs, 2);π    {Move the path into place}π    Path := Upper(Path);π    Move(Path[1], EPtr^[EOfs], PLen);π    {Null terminate}π    Inc(EOfs, PLen);π    EPtr^[EOfs] := #0;π    SetProgramStr := True;π  end;πend;π